home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / dev / lang / bcpl4amiga.lha / bcpl / trn.bpl < prev    next >
Text File  |  1991-01-25  |  24KB  |  941 lines
  1. //    TRN0
  2.  
  3.  
  4. GET "TRNHDR"
  5.  
  6. LET NEXTPARAM() = VALOF
  7.     $( PARAMNUMBER := PARAMNUMBER + 1
  8.        RESULTIS PARAMNUMBER  $)
  9.  
  10. AND TRANSREPORT(N, X) BE
  11.     $( SELECTOUTPUT(SYSPRINT)
  12.        REPORTCOUNT := REPORTCOUNT + 1
  13.        IF REPORTCOUNT GE REPORTMAX DO
  14.                 $( WRITES("*NCOMPILATION ABORTED*N")
  15.                    STOP(8)  $)
  16.        WRITES("*NREPORT:   "); TRNMESSAGE(N)
  17.        WRITEF("*NCOMMANDS COMPILED %N*N", COMCOUNT)
  18.        PLIST(X, 0, 4); NEWLINE()
  19.        SELECTOUTPUT(OCODE)  $)
  20.  
  21. AND TRNMESSAGE(N) BE
  22. $( LET S = VALOF
  23.     SWITCHON N INTO
  24.  
  25.     $( DEFAULT: WRITEF("COMPILER ERROR  %N", N); RETURN
  26.  
  27.        CASE 141: RESULTIS "TOO MANY CASES"
  28.        CASE 104: RESULTIS "ILLEGAL USE OF BREAK, LOOP OR RESULTIS"
  29.        CASE 101:
  30.        CASE 105: RESULTIS "ILLEGAL USE OF CASE OR DEFAULT"
  31.        CASE 106: RESULTIS "TWO CASES WITH SAME CONSTANT"
  32.        CASE 144: RESULTIS "TOO MANY GLOBALS"
  33.        CASE 142: RESULTIS "NAME DECLARED TWICE"
  34.        CASE 143: RESULTIS "TOO MANY NAMES DECLARED"
  35.        CASE 115: RESULTIS "NAME NOT DECLARED"
  36.        CASE 116: RESULTIS "DYNAMIC FREE VARIABLE USED"
  37.        CASE 117:CASE 118:CASE 119:
  38.                  RESULTIS "ERROR IN CONSTANT EXPRESSION"
  39.        CASE 110:CASE 112:
  40.                  RESULTIS "LHS AND RHS DO NOT MATCH"
  41.        CASE 109:CASE 113:
  42.                  RESULTIS "LTYPE EXPRESSION EXPECTED"
  43.                    $)
  44.  
  45.    WRITES(S)   $)
  46.  
  47.  
  48. LET COMPILEAE(X) BE
  49.    $(1 LET A = VEC 1200
  50.        LET D = VEC 100
  51.        LET K = VEC 150
  52.        LET L = VEC 150
  53.  
  54.        DVEC, DVECS, DVECE, DVECP, DVECT := A, 3, 3, 3, 1200
  55.        DVEC!0, DVEC!1, DVEC!2 := 0, 0, 0
  56.  
  57.        GLOBDECL, GLOBDECLS, GLOBDECLT := D, 0, 100
  58.  
  59.        CASEK, CASEL, CASEP, CASET, CASEB := K, L, 0, 150, -1
  60.        ENDCASELABEL, DEFAULTLABEL := 0, 0
  61.  
  62.        RESULTLABEL, BREAKLABEL, LOOPLABEL := -1, -1, -1
  63.  
  64.        COMCOUNT, CURRENTBRANCH := 0, X
  65.  
  66.        OCOUNT := 0
  67.  
  68.        PARAMNUMBER := 0
  69.        SSP := SAVESPACESIZE
  70.        OUT2(S.STACK, SSP)
  71.        DECLLABELS(X)
  72.        TRANS(X)
  73.        OUT2(S.GLOBAL, GLOBDECLS/2)
  74.  
  75.     $( LET I = 0
  76.        UNTIL I=GLOBDECLS DO
  77.           $( OUTN(GLOBDECL!I)
  78.              OUTL(GLOBDECL!(I+1))
  79.              I := I + 2  $)
  80.  
  81.        ENDOCODE()  $)1
  82.  
  83. .
  84.  
  85. //    TRN1
  86.  
  87.  
  88. GET "TRNHDR"
  89.  
  90. LET TRANS(X) BE
  91.   $(TR
  92. NEXT:
  93.  $( LET SW = FALSE
  94.     IF X=0 RETURN
  95.     CURRENTBRANCH := X
  96.  
  97.     SWITCHON H1!X INTO
  98. $(  DEFAULT: TRANSREPORT(100, X); RETURN
  99.  
  100.     CASE S.LET:
  101.       $( LET A, B, S, S1 = DVECE, DVECS, SSP, 0
  102.          LET V = VECSSP
  103.          DECLNAMES(H2!X)
  104.          CHECKDISTINCT(B, DVECS)
  105.          DVECE := DVECS
  106.          VECSSP, S1 := SSP, SSP
  107.          SSP := S
  108.          TRANSDEF(H2!X)
  109.          UNLESS SSP=S1 DO TRANSREPORT(110, X)
  110.          UNLESS SSP=VECSSP DO $( SSP := VECSSP
  111.                                  OUT2(S.STACK, SSP)  $)
  112.          OUT1(S.STORE)
  113.          DECLLABELS(H3!X)
  114.          TRANS(H3!X)
  115.          VECSSP := V
  116.          UNLESS SSP=S DO OUT2(S.STACK, S)
  117.          DVECE, DVECS, SSP := A, B, S
  118.          RETURN   $)
  119.  
  120.     CASE S.STATIC:
  121.     CASE S.GLOBAL:
  122.     CASE S.MANIFEST:
  123.      $(1 LET A, B, S = DVECE, DVECS, SSP
  124.          AND OP = H1!X
  125.          AND Y = H2!X
  126.  
  127.          IF OP=S.MANIFEST DO OP := S.NUMBER
  128.  
  129.          UNTIL Y=0 DO
  130.            $( TEST OP=S.STATIC THEN
  131.                 $( LET M = NEXTPARAM()
  132.                    ADDNAME(H3!Y, S.LABEL, M)
  133.                    COMPDATALAB(M)
  134.                    OUT2(S.ITEMN, EVALCONST(H4!Y))  $)
  135.  
  136.                 OR ADDNAME(H3!Y, OP, EVALCONST(H4!Y))
  137.  
  138.               Y := H2!Y
  139.               DVECE := DVECS  $)
  140.  
  141.          DECLLABELS(H3!X)
  142.          TRANS(H3!X)
  143.          DVECE, DVECS, SSP := A, B, S
  144.          RETURN   $)1
  145.  
  146.  
  147.     CASE S.ASS:
  148.        ASSIGN(H2!X, H3!X)
  149.        RETURN
  150.  
  151.     CASE S.RTAP:
  152.      $( LET S = SSP
  153.         SSP := SSP+SAVESPACESIZE
  154.         OUT2(S.STACK, SSP)
  155.         LOADLIST(H3!X)
  156.         LOAD(H2!X)
  157.         OUT2(S.RTAP, S)
  158.         SSP := S
  159.         RETURN  $)
  160.  
  161.     CASE S.GOTO:
  162.         LOAD(H2!X)
  163.         OUT1(S.GOTO)
  164.         SSP := SSP-1
  165.         RETURN
  166.  
  167.     CASE S.COLON:
  168.         COMPLAB(H4!X)
  169.         TRANS(H3!X)
  170.         RETURN
  171.  
  172.     CASE S.UNLESS: SW := TRUE
  173.     CASE S.IF:
  174.      $( LET L = NEXTPARAM()
  175.         JUMPCOND(H2!X, SW, L)
  176.         TRANS(H3!X)
  177.         COMPLAB(L)
  178.         RETURN   $)
  179.  
  180.     CASE S.TEST:
  181.      $( LET L, M = NEXTPARAM(), NEXTPARAM()
  182.         JUMPCOND(H2!X, FALSE, L)
  183.         TRANS(H3!X)
  184.         COMPJUMP(M)
  185.         COMPLAB(L)
  186.         TRANS(H4!X)
  187.         COMPLAB(M)
  188.         RETURN   $)
  189.  
  190.     CASE S.LOOP:
  191.         IF LOOPLABEL<0 DO TRANSREPORT(104, X)
  192.         IF LOOPLABEL=0 DO LOOPLABEL := NEXTPARAM()
  193.         COMPJUMP(LOOPLABEL)
  194.         RETURN
  195.  
  196.     CASE S.BREAK:
  197.         IF BREAKLABEL<0 DO TRANSREPORT(104, X)
  198.         IF BREAKLABEL=0 DO BREAKLABEL := NEXTPARAM()
  199.         COMPJUMP(BREAKLABEL)
  200.         RETURN
  201.  
  202.     CASE S.RETURN: OUT1(S.RTRN)
  203.                    RETURN
  204.  
  205.     CASE S.FINISH: OUT1(S.FINISH)
  206.                    RETURN
  207.  
  208.     CASE S.RESULTIS:
  209.         IF RESULTLABEL<0 DO TRANSREPORT(104, X)
  210.         LOAD(H2!X)
  211.         OUT2P(S.RES, RESULTLABEL)
  212.         SSP := SSP - 1
  213.         RETURN
  214.  
  215.     CASE S.WHILE: SW := TRUE
  216.     CASE S.UNTIL:
  217.      $( LET L, M = NEXTPARAM(), NEXTPARAM()
  218.         LET BL, LL = BREAKLABEL, LOOPLABEL
  219.         BREAKLABEL, LOOPLABEL := 0, M
  220.  
  221.         COMPJUMP(M)
  222.         COMPLAB(L)
  223.         TRANS(H3!X)
  224.         COMPLAB(M)
  225.         JUMPCOND(H2!X, SW, L)
  226.         UNLESS BREAKLABEL=0 DO COMPLAB(BREAKLABEL)
  227.         BREAKLABEL, LOOPLABEL := BL, LL
  228.         RETURN   $)
  229.  
  230.     CASE S.REPEATWHILE: SW := TRUE
  231.     CASE S.REPEATUNTIL:
  232.     CASE S.REPEAT:
  233.      $( LET L, BL, LL = NEXTPARAM(), BREAKLABEL, LOOPLABEL
  234.         BREAKLABEL, LOOPLABEL := 0, 0
  235.         COMPLAB(L)
  236.         TEST H1!X=S.REPEAT
  237.             THEN $( LOOPLABEL := L
  238.                     TRANS(H2!X)
  239.                     COMPJUMP(L)  $)
  240.               OR $( TRANS(H2!X)
  241.                     UNLESS LOOPLABEL=0 DO COMPLAB(LOOPLABEL)
  242.                     JUMPCOND(H3!X, SW, L)  $)
  243.         UNLESS BREAKLABEL=0 DO COMPLAB(BREAKLABEL)
  244.         BREAKLABEL, LOOPLABEL := BL, LL
  245.         RETURN   $)
  246.  
  247.     CASE S.CASE:
  248.      $( LET L, K = NEXTPARAM(), EVALCONST(H2!X)
  249.         IF CASEP>=CASET DO TRANSREPORT(141, X)
  250.         IF CASEB<0 DO TRANSREPORT(105, X)
  251.         FOR I = CASEB TO CASEP-1 DO
  252.                     IF CASEK!I=K DO TRANSREPORT(106, X)
  253.         CASEK!CASEP := K
  254.         CASEL!CASEP := L
  255.         CASEP := CASEP + 1
  256.         COMPLAB(L)
  257.         TRANS(H3!X)
  258.         RETURN   $)
  259.  
  260.     CASE S.DEFAULT:
  261.         IF CASEB<0 DO TRANSREPORT(105, X)
  262.         UNLESS DEFAULTLABEL=0 DO TRANSREPORT(101, X)
  263.         DEFAULTLABEL := NEXTPARAM()
  264.         COMPLAB(DEFAULTLABEL)
  265.         TRANS(H2!X)
  266.         RETURN
  267.  
  268.     CASE S.ENDCASE: IF CASEB<0 DO TRANSREPORT(105, X)
  269.                     COMPJUMP(ENDCASELABEL)
  270.                     RETURN
  271.  
  272.     CASE S.SWITCHON:
  273.         TRANSSWITCH(X)
  274.         RETURN
  275.  
  276.     CASE S.FOR: TRANSFOR(X)
  277.                 RETURN
  278.  
  279.     CASE S.SEQ:
  280.         TRANS(H2!X)
  281.         COMCOUNT :=  COMCOUNT + 1
  282.         X := H3!X
  283.         GOTO NEXT        $)TR
  284. .
  285.  
  286. //    TRN2
  287.  
  288.  
  289. GET "TRNHDR"
  290.  
  291. LET DECLNAMES(X) BE UNLESS X=0 SWITCHON H1!X INTO
  292.  
  293.      $(  DEFAULT: TRANSREPORT(102, CURRENTBRANCH)
  294.                   RETURN
  295.  
  296.          CASE S.VECDEF: CASE S.VALDEF:
  297.                DECLDYN(H2!X)
  298.                RETURN
  299.  
  300.          CASE S.RTDEF: CASE S.FNDEF:
  301.                H5!X := NEXTPARAM()
  302.                DECLSTAT(H2!X, H5!X)
  303.                RETURN
  304.  
  305.          CASE S.AND:
  306.                DECLNAMES(H2!X)
  307.                DECLNAMES(H3!X)
  308.                RETURN    $)
  309.  
  310.  
  311. AND DECLDYN(X) BE UNLESS X=0 DO
  312.  
  313.     $( IF H1!X=S.NAME DO
  314.           $( ADDNAME(X, S.LOCAL, SSP)
  315.              SSP := SSP + 1
  316.              RETURN   $)
  317.  
  318.        IF H1!X=S.COMMA DO
  319.           $( ADDNAME(H2!X, S.LOCAL, SSP)
  320.              SSP := SSP + 1
  321.              DECLDYN(H3!X)
  322.              RETURN  $)
  323.  
  324.        TRANSREPORT(103, X)   $)
  325.  
  326. AND DECLSTAT(X, L) BE
  327.     $(1 LET T = CELLWITHNAME(X)
  328.  
  329.        IF DVEC!(T+1)=S.GLOBAL DO
  330.           $( LET N = DVEC!(T+2)
  331.              ADDNAME(X, S.GLOBAL, N)
  332.              IF GLOBDECLS>=GLOBDECLT DO TRANSREPORT(144, X)
  333.              GLOBDECL!GLOBDECLS := N
  334.              GLOBDECL!(GLOBDECLS+1) := L
  335.              GLOBDECLS := GLOBDECLS + 2
  336.              RETURN  $)
  337.  
  338.  
  339.     $( LET M = NEXTPARAM()
  340.        ADDNAME(X, S.LABEL, M)
  341.        COMPDATALAB(M)
  342.        OUT2P(S.ITEML, L)    $)1
  343.  
  344.  
  345. AND DECLLABELS(X) BE
  346.     $( LET B = DVECS
  347.        SCANLABELS(X)
  348.        CHECKDISTINCT(B, DVECS)
  349.        DVECE := DVECS   $)
  350.  
  351.  
  352. AND CHECKDISTINCT(E, S) BE
  353.        UNTIL E=S DO
  354.           $( LET P = E + 3
  355.              AND N = DVEC!E
  356.              WHILE P<S DO
  357.                 $( IF DVEC!P=N DO TRANSREPORT(142, N)
  358.                    P := P + 3  $)
  359.              E := E + 3  $)
  360.  
  361.  
  362. AND ADDNAME(N, P, A) BE
  363.     $( IF DVECS>=DVECT DO TRANSREPORT(143, CURRENTBRANCH)
  364.        DVEC!DVECS, DVEC!(DVECS+1), DVEC!(DVECS+2) := N, P, A
  365.        DVECS := DVECS + 3  $)
  366.  
  367.  
  368. AND CELLWITHNAME(N) = VALOF
  369.     $( LET X = DVECE
  370.  
  371.        X := X - 3 REPEATUNTIL X=0 \/ DVEC!X=N
  372.  
  373.        RESULTIS X  $)
  374.  
  375.  
  376. AND SCANLABELS(X) BE UNLESS X=0 SWITCHON H1!X INTO
  377.  
  378.     $( DEFAULT: RETURN
  379.  
  380.        CASE S.COLON:
  381.             H4!X := NEXTPARAM()
  382.             DECLSTAT(H2!X, H4!X)
  383.  
  384.        CASE S.IF: CASE S.UNLESS: CASE S.WHILE: CASE S.UNTIL:
  385.        CASE S.SWITCHON: CASE S.CASE:
  386.             SCANLABELS(H3!X)
  387.             RETURN
  388.  
  389.        CASE S.SEQ:
  390.             SCANLABELS(H3!X)
  391.  
  392.        CASE S.REPEAT:
  393.        CASE S.REPEATWHILE: CASE S.REPEATUNTIL: CASE S.DEFAULT:
  394.             SCANLABELS(H2!X)
  395.             RETURN
  396.  
  397.        CASE S.TEST:
  398.             SCANLABELS(H3!X)
  399.             SCANLABELS(H4!X)
  400.             RETURN    $)
  401.  
  402.  
  403. AND TRANSDEF(X) BE
  404.     $(1 TRANSDYNDEFS(X)
  405.         IF STATDEFS(X) DO
  406.            $( LET L, S= NEXTPARAM(), SSP
  407.               COMPJUMP(L)
  408.               TRANSSTATDEFS(X)
  409.               SSP := S
  410.               OUT2(S.STACK, SSP)
  411.               COMPLAB(L)  $)1
  412.  
  413.  
  414. AND TRANSDYNDEFS(X) BE
  415.         SWITCHON H1!X INTO
  416.      $( CASE S.AND:
  417.             TRANSDYNDEFS(H2!X)
  418.             TRANSDYNDEFS(H3!X)
  419.             RETURN
  420.  
  421.         CASE S.VECDEF:
  422.             OUT2(S.LLP, VECSSP)
  423.             SSP := SSP + 1
  424.             VECSSP := VECSSP + 1 + EVALCONST(H3!X)
  425.             RETURN
  426.  
  427.         CASE S.VALDEF: LOADLIST(H3!X)
  428.                        RETURN
  429.  
  430.         DEFAULT: RETURN  $)
  431.  
  432. AND TRANSSTATDEFS(X) BE
  433.         SWITCHON H1!X INTO
  434.      $( CASE S.AND:
  435.              TRANSSTATDEFS(H2!X)
  436.              TRANSSTATDEFS(H3!X)
  437.              RETURN
  438.  
  439.         CASE S.FNDEF: CASE S.RTDEF:
  440.          $(2 LET A, B, C = DVECE, DVECS, DVECP
  441.              AND BL, LL = BREAKLABEL, LOOPLABEL
  442.              AND RL, CB = RESULTLABEL, CASEB
  443.              BREAKLABEL, LOOPLABEL := -1, -1
  444.              RESULTLABEL, CASEB := -1, -1
  445.  
  446.              COMPENTRY(H2!X, H5!X)
  447.              SSP := SAVESPACESIZE
  448.  
  449.              DVECP := DVECS
  450.              DECLDYN(H3!X)
  451.              CHECKDISTINCT(B, DVECS)
  452.              DVECE := DVECS
  453.              DECLLABELS(H4!X)
  454.  
  455.              OUT2(S.SAVE, SSP)
  456.  
  457.              TEST H1!X=S.FNDEF
  458.                 THEN $( LOAD(H4!X); OUT1(S.FNRN)  $)
  459.                   OR $( TRANS(H4!X); OUT1(S.RTRN)  $)
  460.  
  461.              OUT2(S.ENDPROC, 0)
  462.  
  463.              BREAKLABEL, LOOPLABEL := BL, LL
  464.              RESULTLABEL, CASEB := RL, CB
  465.              DVECE, DVECS, DVECP := A, B, C   $)2
  466.  
  467.         DEFAULT: RETURN   $)
  468.  
  469. AND STATDEFS(X) = H1!X=S.FNDEF \/ H1!X=S.RTDEF -> TRUE,
  470.                   H1!X NE S.AND -> FALSE,
  471.                   STATDEFS(H2!X) -> TRUE,
  472.                   STATDEFS(H3!X)
  473.  
  474.  
  475. .
  476.  
  477. //    TRN3
  478.  
  479.  
  480. GET "TRNHDR"
  481.  
  482. LET JUMPCOND(X, B, L) BE
  483. $(JC LET SW = B
  484.      SWITCHON H1!X INTO
  485.      $( CASE S.FALSE: B := NOT B
  486.         CASE S.TRUE: IF B DO COMPJUMP(L)
  487.                      RETURN
  488.  
  489.         CASE S.NOT: JUMPCOND(H2!X, NOT B, L)
  490.                     RETURN
  491.  
  492.         CASE S.LOGAND: SW := NOT SW
  493.         CASE S.LOGOR:
  494.          TEST SW THEN $( JUMPCOND(H2!X, B, L)
  495.                          JUMPCOND(H3!X, B, L)  $)
  496.  
  497.                    OR $( LET M = NEXTPARAM()
  498.                          JUMPCOND(H2!X, NOT B, M)
  499.                          JUMPCOND(H3!X, B, L)
  500.                          COMPLAB(M)  $)
  501.  
  502.          RETURN
  503.  
  504.         DEFAULT: LOAD(X)
  505.                  OUT2P(B -> S.JT, S.JF, L)
  506.                  SSP := SSP - 1
  507.                  RETURN     $)JC
  508.  
  509. AND TRANSSWITCH(X) BE
  510.     $(1 LET P, B, DL = CASEP, CASEB, DEFAULTLABEL
  511.         AND ECL = ENDCASELABEL
  512.         LET L = NEXTPARAM()
  513.         ENDCASELABEL := NEXTPARAM()
  514.         CASEB := CASEP
  515.  
  516.         COMPJUMP(L)
  517.         DEFAULTLABEL := 0
  518.         TRANS(H3!X)
  519.         COMPJUMP(ENDCASELABEL)
  520.  
  521.         COMPLAB(L)
  522.         LOAD(H2!X)
  523.         IF DEFAULTLABEL=0 DO DEFAULTLABEL := ENDCASELABEL
  524.         OUT3P(S.SWITCHON, CASEP-P, DEFAULTLABEL)
  525.  
  526.         FOR I = CASEB TO CASEP-1 DO $( OUTN(CASEK!I)
  527.                                        OUTL(CASEL!I)  $)
  528.  
  529.         SSP := SSP - 1
  530.         COMPLAB(ENDCASELABEL)
  531.         ENDCASELABEL := ECL
  532.         CASEP, CASEB, DEFAULTLABEL := P, B, DL   $)1
  533.  
  534. AND TRANSFOR(X) BE
  535.      $( LET A, B = DVECE, DVECS
  536.         LET L, M = NEXTPARAM(), NEXTPARAM()
  537.         LET BL, LL = BREAKLABEL, LOOPLABEL
  538.         LET K, N = 0, 0
  539.         LET STEP = 1
  540.         LET S = SSP
  541.         BREAKLABEL, LOOPLABEL := 0, 0
  542.  
  543.         ADDNAME(H2!X, S.LOCAL, S)
  544.         DVECE := DVECS
  545.         LOAD(H3!X)
  546.  
  547.         TEST H1!(H4!X)=S.NUMBER
  548.             THEN K, N := S.LN, H2!(H4!X)
  549.               OR $( K, N := S.LP, SSP
  550.                     LOAD(H4!X)  $)
  551.  
  552.         UNLESS H5!X=0 DO STEP := EVALCONST(H5!X)
  553.  
  554.         OUT1(S.STORE)
  555.         COMPJUMP(L)
  556.         DECLLABELS(H6!X)
  557.         COMPLAB(M)
  558.         TRANS(H6!X)
  559.         UNLESS LOOPLABEL=0 DO COMPLAB(LOOPLABEL)
  560.         OUT2(S.LP, S); OUT2(S.LN, STEP); OUT1(S.PLUS); OUT2(S.SP, S)
  561.         COMPLAB(L)
  562.         OUT2(S.LP, S); OUT2(K, N); OUT1(STEP<0 -> S.GE, S.LE)
  563.         OUT2P(S.JT, M)
  564.  
  565.         UNLESS BREAKLABEL=0 DO COMPLAB(BREAKLABEL)
  566.         BREAKLABEL, LOOPLABEL, SSP := BL, LL, S
  567.         OUT2(S.STACK, SSP)
  568.         DVECE, DVECS := A, B  $)
  569.  
  570. .
  571.  
  572. //    TRN4
  573.  
  574.  
  575. GET "TRNHDR"
  576.  
  577. LET LOAD(X) BE
  578.     $(1 IF X=0 DO $( TRANSREPORT(148, CURRENTBRANCH)
  579.                      LOADZERO()
  580.                      RETURN  $)
  581.  
  582.      $( LET OP = H1!X
  583.  
  584.         SWITCHON OP INTO
  585.      $( DEFAULT: TRANSREPORT(147, CURRENTBRANCH)
  586.                  LOADZERO()
  587.                  RETURN
  588.  
  589.         CASE S.DIV: CASE S.REM: CASE S.MINUS:
  590.         CASE S.LS: CASE S.GR: CASE S.LE: CASE S.GE:
  591.         CASE S.LSHIFT: CASE S.RSHIFT:
  592.             LOAD(H2!X)
  593.             LOAD(H3!X)
  594.             OUT1(OP)
  595.             SSP := SSP - 1
  596.             RETURN
  597.  
  598.         CASE S.VECAP: CASE S.MULT: CASE S.PLUS: CASE S.EQ: CASE S.NE:
  599.         CASE S.LOGAND: CASE S.LOGOR: CASE S.EQV: CASE S.NEQV:
  600.          $( LET A, B = H2!X, H3!X
  601.             IF H1!A=S.NAME \/ H1!A=S.NUMBER DO
  602.                                A, B := H3!X, H2!X
  603.             LOAD(A)
  604.             LOAD(B)
  605.             IF OP=S.VECAP DO $( OUT1(S.PLUS); OP := S.RV  $)
  606.             OUT1(OP)
  607.             SSP := SSP - 1
  608.             RETURN   $)
  609.  
  610.         CASE S.NEG: CASE S.NOT: CASE S.RV:
  611.             LOAD(H2!X)
  612.             OUT1(OP)
  613.             RETURN
  614.  
  615.         CASE S.TRUE: CASE S.FALSE: CASE S.QUERY:
  616.             OUT1(OP)
  617.             SSP := SSP + 1
  618.             RETURN
  619.  
  620.         CASE S.LV: LOADLV(H2!X)
  621.                    RETURN
  622.  
  623.         CASE S.NUMBER:
  624.             OUT2(S.LN, H2!X)
  625.             SSP := SSP + 1
  626.             RETURN
  627.  
  628.         CASE S.STRING:
  629.          $( LET S = @H2!X
  630.             OUT2(S.LSTR, GETBYTE(S, 0))
  631.             FOR I = 1 TO GETBYTE(S, 0) DO OUTC(GETBYTE(S, I))
  632.             WRC('*S')
  633.             SSP := SSP + 1
  634.             RETURN   $)
  635.  
  636.         CASE S.NAME:
  637.              TRANSNAME(X, S.LP, S.LG, S.LL, S.LN)
  638.              SSP := SSP + 1
  639.              RETURN
  640.  
  641.         CASE S.VALOF:
  642.          $( LET RL = RESULTLABEL
  643.             LET A, B = DVECS, DVECE
  644.             DECLLABELS(H2!X)
  645.             RESULTLABEL := NEXTPARAM()
  646.             TRANS(H2!X)
  647.             COMPLAB(RESULTLABEL)
  648.             OUT2(S.RSTACK, SSP)
  649.             SSP := SSP + 1
  650.             DVECS, DVECE := A, B
  651.             RESULTLABEL := RL
  652.             RETURN   $)
  653.  
  654.  
  655.         CASE S.FNAP:
  656.          $( LET S = SSP
  657.             SSP := SSP + SAVESPACESIZE
  658.             OUT2(S.STACK, SSP)
  659.             LOADLIST(H3!X)
  660.             LOAD(H2!X)
  661.             OUT2(S.FNAP, S)
  662.             SSP := S + 1
  663.             RETURN   $)
  664.  
  665.         CASE S.COND:
  666.          $( LET L, M = NEXTPARAM(), NEXTPARAM()
  667.             LET S = SSP
  668.             JUMPCOND(H2!X, FALSE, M)
  669.             LOAD(H3!X)
  670.             COMPJUMP(L)
  671.             SSP := S; OUT2(S.STACK, SSP)
  672.             COMPLAB(M)
  673.             LOAD(H4!X)
  674.             COMPLAB(L)
  675.             RETURN   $)
  676.  
  677.         CASE S.TABLE:
  678.          $( LET M = NEXTPARAM()
  679.             COMPDATALAB(M)
  680.             X := H2!X
  681.             WHILE H1!X=S.COMMA DO
  682.                   $( OUT2(S.ITEMN, EVALCONST(H2!X))
  683.                      X := H3!X   $)
  684.             OUT2(S.ITEMN, EVALCONST(X))
  685.             OUT2P(S.LLL, M)
  686.             SSP := SSP + 1
  687.             RETURN  $)                         $)1
  688.  
  689.  
  690. AND LOADLV(X) BE
  691.     $(1 IF X=0 GOTO ERR
  692.  
  693.         SWITCHON H1!X INTO
  694.      $( DEFAULT:
  695.         ERR:     TRANSREPORT(113, CURRENTBRANCH)
  696.                  LOADZERO()
  697.                  RETURN
  698.  
  699.         CASE S.NAME:
  700.               TRANSNAME(X, S.LLP, S.LLG, S.LLL, 0)
  701.               SSP := SSP + 1
  702.               RETURN
  703.  
  704.         CASE S.RV:
  705.             LOAD(H2!X)
  706.             RETURN
  707.  
  708.         CASE S.VECAP:
  709.          $( LET A, B = H2!X, H3!X
  710.             IF H1!A=S.NAME DO A, B := H3!X, H2!X
  711.             LOAD(A)
  712.             LOAD(B)
  713.             OUT1(S.PLUS)
  714.             SSP := SSP - 1
  715.             RETURN   $)  $)1
  716.  
  717. AND LOADZERO() BE $( OUT2(S.LN, 0)
  718.                      SSP := SSP + 1  $)
  719.  
  720. AND LOADLIST(X) BE UNLESS X=0 DO
  721.     $( UNLESS H1!X=S.COMMA DO $( LOAD(X); RETURN  $)
  722.  
  723.        LOADLIST(H2!X)
  724.        LOADLIST(H3!X)  $)
  725. .
  726.  
  727. //    TRN5
  728.  
  729.  
  730. GET "TRNHDR"
  731.  
  732. LET EVALCONST(X) = VALOF
  733.     $(1 IF X=0 DO $( TRANSREPORT(117, CURRENTBRANCH)
  734.                      RESULTIS 0  $)
  735.  
  736.         SWITCHON H1!X INTO
  737.      $( DEFAULT: TRANSREPORT(118, X)
  738.                  RESULTIS 0
  739.  
  740.         CASE S.NAME:
  741.          $( LET T = CELLWITHNAME(X)
  742.             IF DVEC!(T+1)=S.NUMBER RESULTIS DVEC!(T+2)
  743.             TRANSREPORT(119, X)
  744.             RESULTIS 0  $)
  745.  
  746.         CASE S.NUMBER: RESULTIS H2!X
  747.         CASE S.TRUE: RESULTIS TRUE
  748.         CASE S.FALSE: RESULTIS FALSE
  749.  
  750.         CASE S.NEG: RESULTIS - EVALCONST(H2!X)
  751.  
  752.         CASE S.MULT: RESULTIS EVALCONST(H2!X) * EVALCONST(H3!X)
  753.         CASE S.DIV:  RESULTIS EVALCONST(H2!X) / EVALCONST(H3!X)
  754.         CASE S.PLUS: RESULTIS EVALCONST(H2!X) + EVALCONST(H3!X)
  755.         CASE S.MINUS:RESULTIS EVALCONST(H2!X) - EVALCONST(H3!X)
  756.                     $)1
  757.  
  758.  
  759. AND ASSIGN(X, Y) BE
  760.     $(1 IF X=0 \/ Y=0 DO
  761.             $( TRANSREPORT(110, CURRENTBRANCH)
  762.                RETURN  $)
  763.  
  764.         SWITCHON H1!X INTO
  765.      $( CASE S.COMMA:
  766.             UNLESS H1!Y=S.COMMA DO
  767.                        $( TRANSREPORT(112, CURRENTBRANCH)
  768.                           RETURN   $)
  769.             ASSIGN(H2!X, H2!Y)
  770.             ASSIGN(H3!X, H3!Y)
  771.             RETURN
  772.  
  773.         CASE S.NAME:
  774.             LOAD(Y)
  775.             TRANSNAME(X, S.SP, S.SG, S.SL, 0)
  776.             SSP := SSP - 1
  777.             RETURN
  778.  
  779.         CASE S.RV: CASE S.VECAP: CASE S.COND:
  780.             LOAD(Y)
  781.             LOADLV(X)
  782.             OUT1(S.STIND)
  783.             SSP := SSP - 2
  784.             RETURN
  785.  
  786.         DEFAULT: TRANSREPORT(109, CURRENTBRANCH)   $)1
  787.  
  788.  
  789. AND TRANSNAME(X, P, G, L, N) BE
  790.     $(1 LET T = CELLWITHNAME(X)
  791.         LET K, A = DVEC!(T+1), DVEC!(T+2)
  792.  
  793.         IF T=0 DO $( TRANSREPORT(115, X)
  794.                      OUT2(G, 2)
  795.                      RETURN  $)
  796.  
  797.         SWITCHON K INTO
  798.         $( CASE S.LOCAL: IF T<DVECP DO TRANSREPORT(116, X)
  799.                          OUT2(P, A); RETURN
  800.  
  801.            CASE S.GLOBAL: OUT2(G, A); RETURN
  802.  
  803.            CASE S.LABEL: OUT2P(L, A); RETURN
  804.  
  805.            CASE S.NUMBER: IF N=0 DO $( TRANSREPORT(113, X)
  806.                                        N := P  $)
  807.                           OUT2(N, A)  $)1
  808.  
  809. .
  810.  
  811. //    TRN6
  812.  
  813.  
  814. GET "TRNHDR"
  815.  
  816. LET COMPLAB(L) BE OUT2P(S.LAB, L)
  817.  
  818. AND COMPENTRY(N, L) BE
  819.     $(  LET S = @N!2
  820.         OUT3P(S.ENTRY, GETBYTE(S, 0), L)
  821.         FOR I = 1 TO GETBYTE(S, 0) DO OUTC(GETBYTE(S, I))
  822.         WRC('*S')  $)
  823.  
  824. AND COMPDATALAB(L) BE OUT2P(S.DATALAB, L)
  825.  
  826. AND COMPJUMP(L) BE OUT2P(S.JUMP, L)
  827.  
  828. AND OUT1(X) BE
  829.     $( WRITEOP(X); WRC('*S')  $)
  830.  
  831. AND OUT2(X, Y) BE
  832.     $( WRITEOP(X); WRC('*S')
  833.        WRN(Y); WRC('*S')   $)
  834.  
  835. AND OUT2P(X, Y) BE
  836.     $( WRITEOP(X); WRC('*S'); WRC('L')
  837.        WRN(Y); WRC('*S')   $)
  838.  
  839. AND OUT3P(X, Y, Z) BE
  840.     $( WRITEOP(X); WRC('*S')
  841.        WRN(Y); WRC('*S'); WRC('L')
  842.        WRN(Z); WRC('*S')   $)
  843.  
  844.  
  845. AND OUTN(N) BE WRN(N)
  846.  
  847. AND OUTL(X) BE
  848.     $( WRC('*S'); WRC('L'); WRN(X); WRC('*S')  $)
  849.  
  850. AND OUTC(X) BE
  851.     $( WRN(CHARCODE(X)); WRC('*S')   $)
  852.  
  853. AND WRITEOP(X) BE
  854.     $(1 LET S = VALOF SWITCHON X INTO
  855.         $( DEFAULT: TRANSREPORT(199, CURRENTBRANCH)
  856.                     RESULTIS 'ERROR'
  857.  
  858.            CASE S.MULT:    RESULTIS "MULT"
  859.            CASE S.DIV:     RESULTIS "DIV"
  860.            CASE S.REM:     RESULTIS "REM"
  861.            CASE S.PLUS:    RESULTIS "PLUS"
  862.            CASE S.MINUS:   RESULTIS "MINUS"
  863.            CASE S.EQ:      RESULTIS "EQ"
  864.            CASE S.NE:      RESULTIS "NE"
  865.            CASE S.LS:      RESULTIS "LS"
  866.            CASE S.GR:      RESULTIS "GR"
  867.            CASE S.LE:      RESULTIS "LE"
  868.            CASE S.GE:      RESULTIS "GE"
  869.            CASE S.LSHIFT:  RESULTIS "LSHIFT"
  870.            CASE S.RSHIFT:  RESULTIS "RSHIFT"
  871.            CASE S.LOGAND:  RESULTIS "LOGAND"
  872.            CASE S.LOGOR:   RESULTIS "LOGOR"
  873.            CASE S.EQV:     RESULTIS "EQV"
  874.            CASE S.NEQV:    RESULTIS "NEQV"
  875.  
  876.            CASE S.NEG:     RESULTIS "NEG"
  877.            CASE S.NOT:     RESULTIS "NOT"
  878.            CASE S.RV:      RESULTIS "RV"
  879.  
  880.            CASE S.TRUE:    RESULTIS "TRUE"
  881.            CASE S.FALSE:   RESULTIS "FALSE"
  882.            CASE S.QUERY:   RESULTIS "QUERY"
  883.  
  884.            CASE S.LP:      RESULTIS "LP"
  885.            CASE S.LG:      RESULTIS "LG"
  886.            CASE S.LN:      RESULTIS "LN"
  887.            CASE S.LSTR:    RESULTIS "LSTR"
  888.            CASE S.LL:      RESULTIS "LL"
  889.  
  890.            CASE S.LLP:     RESULTIS "LLP"
  891.            CASE S.LLG:     RESULTIS "LLG"
  892.            CASE S.LLL:     RESULTIS "LLL"
  893.  
  894.            CASE S.SP:      RESULTIS "SP"
  895.            CASE S.SG:      RESULTIS "SG"
  896.            CASE S.SL:      RESULTIS "SL"
  897.            CASE S.STIND:   RESULTIS "STIND"
  898.  
  899.            CASE S.JUMP:    RESULTIS "JUMP"
  900.            CASE S.JT:      RESULTIS "JT"
  901.            CASE S.JF:      RESULTIS "JF"
  902.            CASE S.GOTO:    RESULTIS "GOTO"
  903.            CASE S.LAB:     RESULTIS "LAB"
  904.            CASE S.STACK:   RESULTIS "STACK"
  905.            CASE S.STORE:   RESULTIS "STORE"
  906.  
  907.            CASE S.ENTRY:   RESULTIS "ENTRY"
  908.            CASE S.SAVE:    RESULTIS "SAVE"
  909.            CASE S.FNAP:    RESULTIS "FNAP"
  910.            CASE S.FNRN:    RESULTIS "FNRN"
  911.            CASE S.RTAP:    RESULTIS "RTAP"
  912.            CASE S.RTRN:    RESULTIS "RTRN"
  913.            CASE S.ENDPROC: RESULTIS "ENDPROC"
  914.            CASE S.RES:     RESULTIS "RES"
  915.            CASE S.RSTACK:  RESULTIS "RSTACK"
  916.            CASE S.FINISH:  RESULTIS "FINISH"
  917.  
  918.            CASE S.SWITCHON:RESULTIS "SWITCHON"
  919.            CASE S.GLOBAL:  RESULTIS "GLOBAL"
  920.            CASE S.DATALAB: RESULTIS "DATALAB"
  921.            CASE S.ITEML:   RESULTIS "ITEML"
  922.            CASE S.ITEMN:   RESULTIS "ITEMN"   $)
  923.  
  924.         FOR I = 1 TO GETBYTE(S, 0) DO WRC(GETBYTE(S, I))   $)1
  925.  
  926.  
  927. AND WRN(N) BE $( IF N<0 DO $( WRC('-'); N := - N  $)
  928.                  WRPN(N)  $)
  929.  
  930. AND WRPN(N) BE $( IF N>9 DO WRPN(N/10)
  931.                   WRC(N REM 10 + '0')  $)
  932.  
  933. AND ENDOCODE() BE $( WRCH('*N'); OCOUNT := 0  $)
  934.  
  935.  
  936. AND WRC(CH) BE $( OCOUNT := OCOUNT + 1
  937.                   IF OCOUNT>62 \/ CH='*S' DO
  938.                             $( WRCH('*N'); OCOUNT := 0; RETURN  $)
  939.                   WRCH(CH)  $)
  940.  
  941.